home *** CD-ROM | disk | FTP | other *** search
/ Wonky Flux Batch 2019 02 / Wonky_Flux_Batch_2019-02.zip / Wonky Flux Batch 2019-02 / 071 - EXFER 4.1 4.2.dsk / EXFER4.0 / ÅØÆÅÒ®ÓÅÇ®Ó next >
Text File  |  2019-02-17  |  26KB  |  1,008 lines
  1. ; ****************************
  2. ;
  3. ;            EXfer:
  4. ; The Extended Transfer Module
  5. ;
  6. ;  This program is for use on
  7. ;  the ProDOS version of GBBS
  8. ;  "Pro" 1.2 or "Pro" 1.3.
  9. ;
  10. ; Written by: Mike Golaszewski
  11. ; (C)1986, All Rights Reserved
  12. ;
  13. ;  Ymodem drivers courtesy of
  14. ;         Greg Schaefer
  15. ;
  16. ; ****************************
  17.  
  18. ; THIS IS NOT FREEWARE
  19.  
  20. ; user segment, version 4.0
  21.  
  22. ; created 08/22/86 - modified 05/26/87
  23.  
  24. ; Special thanks to Mark Roberts for providing much of the ideas and concepts
  25. ; found in EXfer, and for vigorously testing the program; Jerry Cline for his
  26. ; ideas and suggestions; Kieth Christian for his support; Lance Taylor-Warren
  27. ; for providing GBBS 1.3 information; and especially Greg Schaefer ("Gee Ess")
  28. ; for providing the Ymodem drivers.
  29.  
  30. ; define linkable labels
  31.  
  32.  public prompt
  33.  public send.2
  34.  public terminate
  35.  
  36. ; store existing variables
  37.  
  38. enter
  39.  on nocar goto terminate
  40.  print \"XT: Please hold..."
  41.  store "a1:variables":gosub store:clear
  42.  gosub recall:screen$=chr$(12)
  43.  v=0:f$="a1:sys.questions":gosub chkfil
  44.  close:if not(a) then v=13
  45.  b$=right$(lc$,3)+left$(lc$,5):lc$=b$
  46.  when$=ram2+14:ed=-25088:if not(v) goto begin
  47.  byte=ram+37:dl=byte(3)+nibble(3)*256
  48.  ul=byte(4)+nibble(4)*256:byte=ram2
  49.  
  50. ; check for bit map file
  51.  
  52. begin
  53.  f$="a1:xt.bitmap":gosub chkfil:close
  54.  if (not(a)) goto begin.1:else fill ed+1,255,255
  55.  create f$:open #1,f$:write #1,ed+1,255:close
  56.  f$="a1:xt.volumes":kill f$:create f$
  57.  
  58. ; get XMODEM type
  59.  
  60. begin.1
  61.  print \\screen$" :::::::::::::::::::::::::::::::::::::"
  62.  print ": EXfer: The Extended Transfer Module :"
  63.  print ':             Version 4.0             :'
  64.  print " :::::::::::::::::::::::::::::::::::::"
  65.  if not(info(2)) input @2 \"Press [RETURN]..." i$:xm=3:goto start
  66.  input @2 '
  67. XT: Are you using ProTERM or another
  68.     package that supports Ymodem ? ' i$:i$=left$(i$,1)
  69.  if i$="Y" then pt=1:xm=1:goto start
  70.  print '
  71. XT: Please enter the type of XMODEM you
  72.     are using...
  73.  
  74. [1] DOS 3.3 Xmodem (AE "Pro" DOS)
  75. [2] ProDOS Xmodem (Point to Point, AE)
  76. [3] A standard from of Xmodem
  77. [4] No Xmodem drivers, ASCII only'\
  78.  input @2 "XT: Which ? " i$:if i$="" goto exit.1
  79.  a=val(i$):if (a<1) or (a>4) goto begin
  80.  if a=1 then xm=2:else if a=2 then xm=1
  81.  if a=3 then xm=0:else if a=4 then xm=3
  82.  
  83. ; try to access default library
  84.  
  85. start
  86.  bb=c:gosub log:if bf$="" goto start.2
  87.  if not(b2) gosub lsec:goto exit.1
  88.  
  89. ; got it, enter EXfer
  90.  
  91. start.1
  92.  gosub getslt:gosub directory:goto prompt
  93.  
  94. ; library does not exist
  95.  
  96. start.2
  97.  if not(info(5)) print \"XT: Can't find default library...":goto exit.1
  98.  tone(30,30):print \"XT: Source library does not exist..."
  99.  input @2 "    Create ? " i$:if i$<>"Y" goto exit.1:else goto create
  100.  
  101. ; get a command
  102.  
  103. prompt
  104.  on nocar goto terminate
  105.  x=(clock(2)-clock(1))/60:x$=right$("0"+str$(x),2)
  106.  if x=0 then x$="--":else if info(5) then x$="::"
  107.  print \"["x$"] ->";:if zz=1 then zz=0:goto command
  108.  free:clear key:get i$:print chr$(8)" "chr$(8);:push prompt
  109.  
  110. ; check for normal command
  111.  
  112. command
  113.  if (i$="B") and (pt=1) goto batch
  114.  if i$="C" goto copy
  115.  if i$="D" goto directory
  116.  if i$="F" goto search
  117.  if i$="H" goto help
  118.  if i$="I" goto info
  119.  if (i$="J") or (i$="L") goto volume
  120.  if i$="K" goto kill
  121.  if i$="M" goto message
  122.  if i$="N" goto new
  123.  if i$="R" goto receive
  124.  if i$="S" goto send
  125.  if i$="T" goto hangup
  126.  if i$="V" goto view
  127.  if i$="?" goto menu
  128.  if (i$="X") or (i$="Q") goto exit
  129.  
  130. ; check for librarian command
  131.  
  132.  if not(lb) goto prompt.1
  133.  if i$="A" and (info(5)) pop:link "a:exfer.sys","add"
  134.  if i$="E" and (info(5)) pop:link "a:exfer.sys","external"
  135.  if i$="O" pop:link "a:exfer.sys","sort"
  136.  if i$="P" pop:ob=bb:goto create
  137.  if (i$="*") and (info(5)) input @2 "ProDOS: " i$:if i$ use "a:xdos",i$
  138.  
  139. ; not a command
  140.  
  141. prompt.1
  142.  print " "chr$(8);:return
  143.  
  144. ; display a menu
  145. ; ~~~~~~~~~~~~~~
  146.  
  147. menu
  148.  print \\screen$:f$="a1:mnu.exfer"
  149.  if lb f$="a1:sys.exfer"
  150.  open #1,f$:input #1,x$
  151.  setint(" "):for l=1 to len(x$):addint(mid$(x$,l,1))
  152.  next:print \s$\:copy #1
  153.  if key(1) then a=key(0):goto menu.cancel
  154.  if key(3) goto menu.key
  155.  
  156. menu.cancel
  157.  close:setint(""):goto prompt
  158.  
  159. menu.key
  160.  close:setint(""):i$=chr$(key(0))
  161.  zz=1:print:goto prompt
  162.  
  163. ; display help on a command
  164. ; ~~~~~~~~~~~~~~~~~~~~~~~~~
  165.  
  166. help
  167.  input @2 "Help on which command: " i$:if i$="" return
  168.  x$="CDFHIKLMNRSTVX?B":x=instr(i$,x$):if x=0 return
  169.  ready "a1:hlp.exfer":print \s$\:input #msg(x),a,x$
  170.  input #6,x$:setint(1):print x$\:copy #6:setint("")
  171.  ready d2$:return
  172.  
  173. ; message to librarian
  174. ; ~~~~~~~~~~~~~~~~~~~~
  175.  
  176. message
  177.  print \\screen$"Enter feedback: ["edit(3)"] cols, [4K] Max"
  178.  print "[DONE] when finished, [.H] for help":edit(0)
  179.  edit(1):if not(edit(2)) then return:else ready "a:mail"
  180.  x=b1:if not(x) then x=1
  181.  if info(6)<29 print \"XT: Bit-map full":ready d2$:return
  182.  print #msg(x),un:print #6,"EXfer: Feedback from a user"\
  183.  print #6,"From ->"a1$" "a2$" [#"un"]"
  184.  print #6,"Date ->"date$" "time$\:copy #8,#6
  185.  print #msg(x),chr$(4);chr$(0);
  186.  msg(x)=1:update:ready d2$:return
  187.  
  188. ; send a file
  189. ; ~~~~~~~~~~~
  190.  
  191. ; get name & verify it
  192.  
  193. send
  194.  if not(b3) goto lsec
  195.  input @2 "Send: " i$:if i$="" return
  196.  if (val(i$)) or (left$(i$,1)="#") gosub nread:l=l-1:goto send.x
  197.  i$=left$(i$+chr$(32,14),15):gosub read
  198.  if not(l) goto nfile
  199.  
  200. send.x
  201.  if (l<0) goto nfile
  202.  if not(byte(7)) print '
  203. XT: This file must first be validated
  204.     by the sysop before it can be
  205.     accessed...':return
  206.  na$=f$:gosub name:f$=bf$+f$:gosub chkfil
  207.  if a close:goto nfile
  208.  
  209. ; compute time of transfer
  210.  
  211.  close:bs=(byte(8)+byte(9)*256)*4
  212.  c=info(2):if xm=3 goto send.1
  213.  if c=1 then b=bs*4:b=b+(bs/30)
  214.  if c=4 then b=bs:b=b+((bs/30)*6)
  215.  if c=8 then b=bs/2:b=b+((bs/30)*12)
  216.  a=b/60:c=b mod 60:x=(clock(2)-clock(1))/60
  217.  print \"XT: Estimated time of transfer is"
  218.  print "    "a" minutes, "right$("0"+str$(c),2)" seconds"
  219.  if clock(2)=0  goto send.1
  220.  if x<a print '
  221. XT: 'chr$(7)'You do not have enough time left to
  222.     download this file.':return
  223.  
  224. send.1
  225.  if xm=3 print \"XT: Press [RETURN] to begin...";:get i$:print
  226.  if xm<>3 print \"XT: Sending "bs" blocks..."
  227.  use "a:x.dn",xm,f$
  228.  
  229. ; update the record
  230.  
  231. send.2
  232.  on nocar goto terminate
  233.  if not(v) then byte=ram+29:byte(2)=byte(2)+1:byte=ram2
  234.  if v=13 then dl=dl+(peek(-25085)=255)
  235.  byte(16)=byte(16)+1:nb=l:push getslt:goto write
  236.  
  237. ; send batch files
  238. ; ~~~~~~~~~~~~~~~~
  239.  
  240. batch
  241.  if not(b3) goto lsec
  242.  print "Send batch files..."
  243.  print '
  244. XT: Please enter your file list now.  A blank entry will exit the selection
  245.     mode.'\:y=1:flag=ram2+21:fill ram2+20,44,0:pt=2:bs=0
  246.  
  247. ; get a file name or number
  248.  
  249. batch.1
  250.  print "Enter batch file #"right$("00"+str$(y),3);
  251.  input @2 ": " i$:if i$="" goto batch.2
  252.  if (val(i$)) or (left$(i$,1)="#") gosub nread:l=l-1:goto batch.x
  253.  i$=left$(i$+chr$(32,14),15):gosub read
  254.  if not(l) print chr$(8,24)"File doesn't exist"chr$(7):goto batch.1
  255.  
  256. ; make sure file is there and validated
  257.  
  258. batch.x
  259.  if l<0 print chr$(8,24)"File doesn't exist"chr$(7):goto batch.1
  260.  if not(byte(7)) print chr$(8,24)"File must be validated"chr$(7):goto batch.1
  261.  if ty$="LST" print chr$(8,24)"Adding list files"chr$(7):goto lbatch
  262.  z=((byte(8)+byte(9)*256)-1)*4
  263.  print chr$(8,24);i$"  ["right$("000"+str$(z),4)"]"
  264.  if flag(l+1)=0 then y=y+1:bs=bs+(byte(8)+byte(9)*256)-(byte(8)>0)
  265.  flag(l+1)=1:goto batch.1
  266.  
  267. ; got all the files, print a prompt to let them cancel
  268.  
  269. batch.2
  270.  y=y-1:if y=0 then flag=ram+22:pt=1:return
  271.  x=bs/2:bs=bs*4:c=info(2)
  272.  if c=1 then b=x*34
  273.  if c=4 then b=x*9
  274.  if c=8 then b=x*4
  275.  print \"XT: Send "y;:input @0 " files [Y/N] ? " i$
  276.  if i$<>"Y" then flag=ram+22:pt=1:return
  277.  a=b/60:c=b mod 60:x=(clock(2)-clock(1))/60
  278.  print \"XT: Estimated time of transfer is "a" minutes, ";
  279.  print right$("0"+str$(c),2)" seconds":if clock(2)=0 goto batch.3
  280.  if x>a goto batch.3
  281.  print '
  282. XT: 'chr$(7)'You do not have enough time left to download these files.'
  283.  flag=ram+22:pt=1:return
  284.  
  285. batch.3
  286.  poke ram2+20,y:link "a:xt.ymodem"
  287.  
  288. ; we have a file macro, process it
  289.  
  290. lbatch
  291.  gosub name:f$=bf$+f$:open #2,f$
  292.  
  293. ; fake an input to the user
  294.  
  295. lbatch.1
  296.  input #2,i$:if i$="" close:goto batch.1
  297.  if left$(i$,1)=";" goto lbatch.1
  298.  print "Enter batch file #"right$("00"+str$(y),3)": "i$
  299.  i$=left$(i$+chr$(32,14),15):gosub read
  300.  if not(l) print chr$(8,24)"File doesn't exist"chr$(7):goto lbatch.1
  301.  
  302. ; process what we have
  303.  
  304.  if not(byte(7)) print chr$(8,24)"File must be validated"chr$(7):goto lbatch.1
  305.  z=((byte(8)+byte(9)*256)-1)*4
  306.  print chr$(8,24);i$"  ["right$("000"+str$(z),4)"]"
  307.  if flag(l+1)=0 then y=y+1:bs=bs+(byte(8)+byte(9)*256)-(byte(8)>0)
  308.  flag(l+1)=1:goto lbatch.1
  309.  
  310. ; view a file
  311. ; ~~~~~~~~~~~
  312.  
  313. view
  314.  if not(b3) goto lsec
  315.  input @2 "View: " i$:if i$="" return
  316.  if (val(i$)) or (left$(i$,1)="#") gosub nread:goto view.x
  317.  i$=left$(i$+chr$(32,14),15):gosub read
  318.  if not(l) goto nfile
  319.  
  320. view.x
  321.  if not(l) goto nfile
  322.  if not(byte(7)) print '
  323. XT: This file must first be validated
  324.     by the sysop before it can be
  325.     accessed...':return
  326.  gosub name:f$=bf$+f$:gosub dtype
  327.  if ty$<>"TXT" print \"XT: Not a TXT type file...":return
  328.  gosub chkfil:if a close:goto nfile
  329.  print \s$\:setint(1):copy #1:close
  330.  setint(""):return
  331.  
  332. ; show file info
  333. ; ~~~~~~~~~~~~~~
  334.  
  335. ; get filename & look for info
  336.  
  337. info
  338.  input @2 "Info on: " i$:if i$="" return:else na$=i$
  339.  if (val(i$)) or (left$(i$,1)="#") gosub nread:l=l-1:goto info.x
  340.  i$=left$(i$+chr$(32,14),15):gosub read
  341.  if not(l) goto nfile
  342.  
  343. ; see if the file has information
  344.  
  345. info.x
  346.  if l<0 goto nfile:else c=byte(10)+byte(11)*256:d=byte(12)
  347.  if (not(d)) and (lb or (c=un)) goto info.a
  348.  if not(d) print "XT: "chr$(7)"File has no information":return
  349.  
  350. ; display file information
  351.  
  352. info.1
  353.  input #msg(d),z:input #6,i$:gosub name:print \s$\
  354.  setint(1):print "Filename: ";:if lb print bf$;f$:else print i$
  355.  copy #6:setint(""):if lb or (c=un) goto info.a
  356.  return
  357.  
  358. ; see if info is to be added or updated
  359.  
  360. info.a
  361.  if d print '
  362. XT: Edit this information ? ';:else print '
  363. XT: Would you like to enter a short
  364.     description of this upload ? ';
  365.  input @2 i$:i$=left$(i$,1):if i$<>"Y" return
  366.  edit(0):if d input #msg(d),a:input #6,x$\y$\z$:copy #6,#8
  367.  gosub edesc:if not(edit(2)) return:else if d goto info.e
  368.  a=1
  369.  
  370. ; find an empty message for this information
  371.  
  372. info.f
  373.  if msg(a) then a=a+1:else d=a:goto info.s
  374.  if a>msg(0) then d=a:goto info.s
  375.  goto info.f
  376.  
  377. ; replace information
  378.  
  379. info.s
  380.  open #1,d1$:position #1,32,l+1:input #1,na$:close
  381.  kill #msg(d):print #msg(d),un:print #6,na$
  382.  print #6,"Uploader: "a1$" "a2$" [#"un"]"
  383.  print #6,"Uploaded: "date$" "time$\:copy #8,#6
  384.  
  385. ; update the message file & rewrite directory entry
  386.  
  387. info.b
  388.  msg(d)=255:update:open #1,d1$:position #1,32,l+1
  389.  input #1,na$:input #1,ty$:read #1,ram2+7,10:byte(12)=d
  390.  position #1,32,l+1:print #1,na$:print #1,ty$
  391.  write #1,ram2+7,10:close:return
  392.  
  393. ; info already exists
  394.  
  395. info.e
  396.  input #msg(d),a:input #6,x$\y$\z$:kill #msg(d)
  397.  print #msg(d),a:print #6,x$\y$\z$\:copy #8,#6:goto info.b
  398.  
  399. ; kill a file
  400. ; ~~~~~~~~~~~
  401.  
  402. ; make sure the file belongs to the user
  403.  
  404. kill
  405.  input @2 "Kill: " i$:if i$="" return
  406.  if (val(i$)) or (left$(i$,1)="#") gosub nread:l=l-1:goto kill.x
  407.  i$=left$(i$+chr$(32,14),15):gosub read
  408.  if not(l) goto nfile
  409.  
  410. kill.x
  411.  if l<0 goto nfile
  412.  if lb goto kill.1:else a=byte(10)+byte(11)*256
  413.  if a<>un print \"XT: That is not your file":return
  414.  
  415. ; kill the file
  416.  
  417. kill.1
  418.  gosub name:i$="Y":if info(5) input @0 \"XT: Remove file from disk ? " i$
  419.  f$=bf$+f$:if i$="Y" kill f$
  420.  open #1,d1$:position #1,32,l+1:print #1,chr$(13):close
  421.  if not(v) then nibble(3)=nibble(3)-(a=un):else ul=ul-(a=un)
  422.  if not(byte(12)) goto getslt
  423.  
  424. ; scan for the message containing file's information
  425.  
  426. kill.2
  427.  d=byte(12):msg(d)=0:kill #msg(d):update:goto getslt
  428.  
  429. ; receive a file
  430. ; ~~~~~~~~~~~~~~
  431.  
  432. ; get filename & check for conflicts
  433.  
  434. receive
  435.  if not(b4) goto lsec:else if nb=255 goto dfull
  436.  input @2 "Receive: " i$:if i$="" return
  437.  na$=left$(i$+chr$(32,14),15):i$=na$:gosub read
  438.  gosub name:f$=bf$+f$:gosub chkfil:close
  439.  if a and not(l) goto rec.2
  440.  d=0:if lb goto rec.1:else print '
  441. XT: 'chr$(7)"Duplicate name on ProDOS volume":return
  442.  
  443. ; see what sysop wishes to do with duplicate
  444.  
  445. rec.1
  446.  if l then nb=l
  447.  input @0 \"XT: File exists...overwrite ? " i$
  448.  if i$<>"Y" return:else kill f$:d=byte(12)
  449.  
  450. ; if it's a DDD file, switch to standard XMODEM
  451.  
  452. rec.2
  453.  x$=left$(i$+chr$(32,14),15):x=xm:if x=4 goto rec.a
  454.  print \ "XT: Is this a compressed Dalton's Disk
  455.  input @2 "    Disintegrator file [Y/N/Q] ? " i$
  456.  if i$="Q" return
  457.  if i$="Y" then dd=1:xm=0
  458.  
  459. ; get the file
  460.  
  461. rec.a
  462.  create f$:print \"XT: Ready to receive..."
  463.  y=clock(2):a=clock(1):clock(2)=0:use "a:x.up",xm,f$:xm=x
  464.  c=clock(1):clock(2)=y+(c-a)
  465.  if not(v) then nibble(3)=nibble(3)+1:else ul=ul+(peek(-25085)=255)
  466.  if (v=13) and (peek(ed+3)<>255) print '
  467. XT: The file you uploaded was received in
  468.     error and has been automatically
  469.     deleted...':kill f$:return
  470.  
  471. ; compute some file info
  472.  
  473.  gosub dtype:gosub size:gosub sfile:byte(12)=0
  474.  if dd=1 then dd=0:x=254:gosub type:ty$="DDD"
  475.  
  476. ; ask for a description
  477.  
  478.  on nocar goto rec.4
  479.  if d print '
  480. XT: Do you want to change the existing
  481.     file information ? ';:else print '
  482. XT: Would you like to enter a short
  483.     description of this upload ? ';
  484.  input @2 i$:i$=left$(i$,1):if i$<>"Y" goto rec.3
  485.  if d input #msg(d),a:input #6,x$\y$\z$:copy #6,#8
  486.  edit(0):gosub edesc:if not(edit(2)) goto rec.3
  487.  if d then byte(12)=d:kill #msg(d):update:goto rec.i
  488.  a=1
  489.  
  490. rec.f
  491.  if msg(a) then a=a+1:else d=a:goto rec.i
  492.  if a>msg(0) then d=a:goto rec.i
  493.  goto rec.f
  494.  
  495. rec.i
  496.  kill #msg(d):print #msg(d),un:print #6,na$
  497.  print #6,"Uploader: "a1$" "a2$" [#"un"]"
  498.  print #6,"Uploaded: "date$" "time$\:copy #8,#6
  499.  msg(d)=255:update
  500.  
  501. rec.3
  502.  if d then byte(12)=d:d=0
  503.  if not(v) print '
  504. XT: If there is a problem with this
  505.     upload, use the [K] command to
  506.     delete it...'
  507.  push getslt:if nb<>byte(4) goto write:else goto update
  508.  
  509. ; loss of carrier - save file and then hang up
  510.  
  511. rec.4
  512.  if d then byte(12)=d:d=0
  513.  push term.1:if nb<>byte(4) goto write:else goto update
  514.  
  515. ; copy a file
  516. ; ~~~~~~~~~~~
  517.  
  518. copy
  519.  if not(b4) goto lsec:else if nb=255 goto dfull
  520.  input @2 "Copy: " i$:if i$="" return
  521.  na$=left$(i$+chr$(32,14),15):i$=na$:gosub read
  522.  gosub name:f$=bf$+f$:gosub chkfil:close
  523.  if a and not(l) goto copy.2
  524.  if lb goto copy.1:else print '
  525. XT: 'chr$(7)"Duplicate name on ProDOS volume":return
  526.  
  527. ; see what sysop wishes to do with duplicate
  528.  
  529. copy.1
  530.  if l then nb=l
  531.  input @0 \"XT: File exists...overwrite ? " i$
  532.  if i$<>"Y" return:else kill f$
  533.  
  534. ; get the text
  535.  
  536. copy.2
  537.  b=clock(2):a=clock(1):clock(2)=0
  538.  print \\screen$'
  539. For files exceeding 4096 bytes, use the
  540. R)eceive command...
  541.  
  542. Enter text: 'edit(3)' columns, [4K] max
  543. [DONE] when finished, [.H] for help'
  544.  edit(0):edit(1):c=clock(1):clock(2)=b+(c-a):if not(edit(2)) return
  545.  input @0 \"XT: Is this a Ymodem list macro ? " i$
  546.  
  547. ; get some info on the file
  548.  
  549.  create f$:open #1,f$:copy #8,#1:close
  550.  nibble(3)=nibble(3)+1:gosub size:gosub sfile
  551.  byte(12)=0:byte(13)=0:ty$="TXT":if i$="Y" then ty$="LST"
  552.  push getslt:if nb<>byte(4) goto write:else goto update
  553.  
  554. ; new file search
  555. ; ~~~~~~~~~~~~~~~
  556.  
  557. ; scan for existing libraries
  558.  
  559. new
  560.  x=0:y=1:print \\screen$"XT: Display new files..."\\s$
  561.  open #1,"a1:xt.bitmap":read #1,ed+1,255:close
  562.  ob=bb:for z=1 to 255:setint(1):x=peek(ed+z)
  563.  if key(1) then z=255:next:goto new.2
  564.  if x>34 then next:goto new.2
  565.  if not(x) goto new.1:else if flag(x) goto new.1
  566.  next:goto new.2
  567.  
  568. ; display # of new files in library
  569.  
  570. new.1
  571.  bb=z:gosub log:if y print '
  572. XT: Scanning library #'right$("00"+str$(bb),3);
  573.  if not(y) print chr$(8,3);right$("00"+str$(bb),3);
  574.  if bf$="" gosub biterr:next:goto new.2
  575.  y=0:open #1,d1$:for l=1 to byte(4):position #1,32,l+1
  576.  input #1,f$:input #1,ty$:read #1,ram2+7,10
  577.  b$=when$:a$=right$(b$,3)+left$(b$,5):setint(1)
  578.  if f$="" next:close:setint(""):next:goto new.2
  579.  if (lc$<=a$) or (not(byte(7))) then y=y+1:else goto new.x
  580.  byte(17)=x:byte(18)=y:if y=1 print \:gosub dir.h
  581.  gosub dir.e:print:x=byte(17):y=byte(18)
  582.  
  583. new.x
  584.  if key(1) then l=byte(4):z=255
  585.  next:close:setint(""):next
  586.  
  587. ; finished, or interrupted
  588.  
  589. new.2
  590.  setint("")
  591.  print \\"XT: Scan complete, press [RETURN]: ";:get i$
  592.  bb=ob:print:goto log
  593.  
  594. ; search for a file
  595. ; ~~~~~~~~~~~~~~~~~
  596.  
  597. ; get filename & starting library
  598.  
  599. search
  600.  x=0:input @2 "Find: " i$:if i$="" return
  601.  input @2 \"XT: Starting at library #" x$:if x$="" then x=1
  602.  if not(x) then x=val(x$):if (x<1) or (x>255) print '
  603. XT: 'chr$(7)"That library doesn't exist":return
  604.  f$="a1:xv."+str$(x):gosub chkfil:close:if not(a) goto srch.1
  605.  print \"XT:"chr$(7)" Starting library doesn't exist...":return
  606.  
  607. ; scan for existing libraries
  608.  
  609. srch.1
  610.  b=1:print \\screen$"XT: Searching for..."\"  :>"i$\\s$
  611.  ob=bb:open #1,"a1:xt.bitmap":read #1,ed+1,255:close
  612.  for z=x to 255:setint(1):y=peek(ed+z)
  613.  if key(1) then z=255:next:goto srch.3
  614.  if y>34 then next:goto srch.3
  615.  if not(y) goto srch.2:else if flag(y) goto srch.2
  616.  next:goto srch.3
  617.  
  618. ; found a valid volume, scan for entry
  619.  
  620. srch.2
  621.  bb=z:gosub log:if b print '
  622. XT: Scanning library #'right$("00"+str$(bb),3);
  623.  if not(b) print chr$(8,3);right$("00"+str$(bb),3);
  624.  if bf$="" gosub biterr:next:goto srch.3
  625.  b=0:open #1,d1$:for l=1 to byte(4)
  626.  position #1,l+1,32:input #1,f$:setint(1)
  627.  if instr(i$,f$) then b=b+1:else goto srch.x
  628.  input #1,ty$:read #1,ram2+7,10
  629.  if b=1 print \:gosub dir.h
  630.  gosub dir.e:print
  631.  
  632. srch.x
  633.  if key(1) then l=byte(4):z=255
  634.  next:close:setint(""):next
  635.  
  636. ; finished, or interrupted
  637.  
  638. srch.3
  639.  print \\"XT: Scan complete, press [RETURN]: ";:get i$
  640.  bb=ob:print:goto log
  641.  
  642. ; log to a different library
  643. ; ~~~~~~~~~~~~~~~~~~~~~~~~~~
  644.  
  645. ; get new volume & see if it exsists
  646.  
  647. volume
  648.  print "Go to a different library..."\\"XT: Current library is #"bb
  649.  input @2 "    Go to library [?]..." i$:if i$="" return
  650.  if i$="?" goto vol.2:else a=val(i$):if (a<1) or (a>255) print '
  651. XT: 'chr$(7)"That library doesn't exist":return
  652.  
  653. ; try to log to library
  654.  
  655.  ob=bb:bb=a:gosub log:if bf$="" then l=bb:gosub biterr:goto vol.1
  656.  if not(b2) gosub lsec:bb=ob:goto log
  657.  print \"XT: Please hold...":gosub getslt:goto directory
  658.  
  659. ; find out if this library is to be created
  660.  
  661. vol.1
  662.  if not(info(5)) print '
  663. XT: 'chr$(7)"That library doesn't exist":bb=ob:goto log
  664.  tone(20,20):input @0 \"XT: Library doesn't exist...create ? " i$
  665.  if i$<>"Y" then bb=ob:goto log:else goto create
  666.  
  667. ; scan bit map for available libraries
  668.  
  669. vol.2
  670.  print \\screen$"XT: You may access the following..."\\s$\
  671.  open #1,"a1:xt.bitmap":read #1,ed+1,255:close
  672.  open #1,"a1:xt.volumes":for l=1 to 255
  673.  setint(1):x=peek(ed+l):if key(1) then l=255:next:goto vol.4
  674.  if x>34 next:goto vol.4
  675.  if not(x) goto vol.3:else if flag(x) goto vol.3
  676.  next:goto vol.4
  677.  
  678. vol.3
  679.  position #1,32,l:input #1,x$
  680.  print "["right$("00"+str$(l),3)"]: "x$:next
  681.  
  682. ; finished with list
  683.  
  684. vol.4
  685.  close:setint(""):print:clear key:goto volume
  686.  
  687. ; hang up
  688. ; ~~~~~~~
  689.  
  690. ; make sure
  691.  
  692. hangup
  693.  input @2 "Hang up ? " i$:if left$(i$,1)<>"Y" return
  694.  print \" :::::::::::::::::::::::::::::::::::::"
  695.  print ": EXfer v4.0 - (C)1987 M. Golaszewski :"
  696.  print " :::::::::::::::::::::::::::::::::::::"
  697.  
  698. ; do it
  699.  
  700. terminate
  701.  poke ram2,v:when$=ram+20:if not(v) then byte=ram+29:goto term.1
  702.  byte=ram+37:nibble(3)=dl/256:byte(3)=dl mod 256
  703.  nibble(4)=ul/256:byte(4)=ul mod 256
  704.  
  705. term.1
  706.  clear:recall "a1:variables":kill "a1:variables":x=peek(ram2)
  707.  if x=13 then ul=byte(4)+nibble(4)*256:dl=byte(3)+nibble(3)*256
  708.  link "a:main.seg","termin2"
  709.  
  710. ; exit back to the board
  711. ; ~~~~~~~~~~~~~~~~~~~~~~
  712.  
  713. ; make sure
  714.  
  715. exit
  716.  input @2 "Exit back to the BBS ? " i$:if left$(i$,1)<>"Y" return
  717.  print \" :::::::::::::::::::::::::::::::::::::"
  718.  print ": EXfer v4.0 - (C)1987 M. Golaszewski :"
  719.  print " :::::::::::::::::::::::::::::::::::::"
  720.  
  721. ; recall variables & add uploads & downloads
  722.  
  723. exit.1
  724.  poke ram2,v:when$=ram+20:if not(v) then byte=ram+29:goto exit.2
  725.  byte=ram+37:nibble(3)=dl/256:byte(3)=dl mod 256
  726.  nibble(4)=ul/256:byte(4)=ul mod 256
  727.  
  728. exit.2
  729.  clear:recall "a1:variables":kill "a1:variables":x=peek(ram2)
  730.  if x=13 then ul=byte(4)+nibble(4)*256:dl=byte(3)+nibble(3)*256
  731.  link "a:main.seg","fromsys"
  732.  
  733. ; routines to edit or create libraries
  734. ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  735.  
  736. create
  737.  link "a:exfer.sys","create"
  738.  
  739. ; :::::::::::::::::::
  740. ; library subroutines
  741. ; :::::::::::::::::::
  742.  
  743. ; catalog a library
  744. ; ~~~~~~~~~~~~~~~~~
  745.  
  746. ; print directory headers
  747.  
  748. directory
  749.  print \\screen$:gosub dir.h:use "a1:xtyp",bf$
  750.  
  751. ; grab an entry
  752.  
  753.  open #1,d1$:for l=1 to byte(4):f$=""
  754.  position #1,32,l+1:input #1,f$:input #1,ty$
  755.  position #1,32,l+1,20:read #1,ram2+7,10:if f$="" goto dir.1
  756.  setint(1)
  757.  
  758. ; if its valid, print it
  759.  
  760.  gosub dir.e:print:if byte(7) goto dir.1
  761.  if (not(byte(7))) and (not(lb)) goto dir.1
  762.  
  763. ; update if not validated
  764.  
  765.  print chr$(7,3);"** Validate above file [Y/N/K] ? ";:get i$
  766.  print chr$(8,35);chr$(32,35);chr$(8,35)
  767.  if i$="Y" position #1,32,l+1,20:print #1,chr$(255);
  768.  if i$<>"K" goto dir.1:else position #1,32,l+1:print #1,chr$(13)
  769.  i$=f$:gosub name:kill f$:if l<nb then nb=l
  770.  
  771. dir.1
  772.  if key(1) then l=byte(4)
  773.  next:close:setint("")
  774.  x=peek(865)+peek(866)*256:y=peek(867)+peek(868)*256
  775.  z=x-y:print \"Kbytes Free: "left$(str$(z)+chr$(32,3),4);
  776.  print "     ";right$("   Kbytes Used: "+str$(y),17);
  777.  if edit(3)>39 print chr$(32,8)"Total Kbytes: "x:else print
  778.  return
  779.  
  780. ; :::::::::::::::::::::
  781. ; directory subroutines
  782. ; :::::::::::::::::::::
  783.  
  784. ; show a directory header
  785.  
  786. dir.h
  787.  print right$("00"+str$(bb),3)": "bn$;
  788.  if edit(3)>39 print "                        Librarian:";
  789.  print " "right$("00"+str$(b1),3)\
  790.  print " #  Filename        Typ I Size Uploaded";
  791.  if edit(3)>39 print " Uploader Downloaded Miscellaneous"\:else print\
  792.  return
  793.  
  794. ; show a directory entry
  795.  
  796. dir.e
  797.  print right$("00"+str$(l+1),3)" "f$" "ty$" ";
  798.  if byte(12) print "Y ";:else print "N ";
  799.  x=byte(8)+byte(9)*256:print right$("   "+str$(x),4)" ";
  800.  b$=when$:if (not(byte(7))) print "VALIDATE";:else print b$;
  801.  a$=right$(b$,3)+left$(b$,5):y=byte(16):x=byte(10)+byte(11)*2 56
  802.  if edit(3)=39 print \"    [U/L Usr "right$("00"+str$(x),3)"]";
  803.  if edit(3)>39 print " User "right$("00"+str$(x),3);
  804.  if edit(3)=39 print " [D/L "right$("00"+str$(y),3)" times]";
  805.  if edit(3)>39 print "  "right$("00"+str$(y),3)" times";
  806.  if lc$<=a$ print " [NEW]";
  807.  return
  808.  
  809. ; ::::::::::::::::::::
  810. ; disk I/O subroutines
  811. ; ::::::::::::::::::::
  812.  
  813. ; log to a library and get some dir info
  814. ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  815.  
  816. log
  817.  byte=ram2:fill ram2,32,0:bf$="":z$="a1:xv."+str$(bb)
  818.  open #1,z$:input #1,bn$:input #1,bf$
  819.  read #1,ram2,7:close:b1=byte(5)+byte(6)*256
  820.  b2=1:if byte(0) then b2=flag(byte(0))
  821.  b3=1:if byte(1) then b3=flag(byte(1))
  822.  b4=1:if byte(2) then b4=flag(byte(2))
  823.  lb=(un=b1):if info(5) then lb=1:b2=1:b3=1:b4=1
  824.  d1$="a1:xv."+str$(bb):d2$="a1:dv."+str$(bb)
  825.  if bf$ ready d2$:bf$=left$(bf$,instr(":",bf$))
  826.  return
  827.  
  828. ; get an empty slot
  829. ; ~~~~~~~~~~~~~~~~~
  830.  
  831. getslt
  832.  nb=0:open #1,d1$:for l=1 to byte(4)
  833.  position #1,32,l+1:input #1,i$
  834.  if (i$="") and (nb=0) then nb=l:l=byte(4)
  835.  next:close:if not(nb) then nb=byte(4)
  836.  return
  837.  
  838. ; update "number of entries" counter
  839. ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  840.  
  841. update
  842.  byte(4)=byte(4)+1:open #1,d1$:print #1,bn$
  843.  print #1,bf$:write #1,ram2,7:close
  844.  
  845. ; write a directory entry
  846. ; ~~~~~~~~~~~~~~~~~~~~~~~
  847.  
  848. write
  849.  open #1,d1$:position #1,32,nb+1:print #1,na$
  850.  print #1,ty$:write #1,ram2+7,10:close
  851.  z=nb:return
  852.  
  853. ; read a directory entry
  854. ; ~~~~~~~~~~~~~~~~~~~~~~
  855.  
  856. read
  857.  open #1,d1$:for l=1 to byte(4)
  858.  position #1,32,l+1:input #1,f$
  859.  if instr(i$,f$)=1 then p=l:l=byte(4):next:l=p:goto read.1
  860.  next:close #1:l=0:return
  861.  
  862. read.1
  863.  input #1,ty$:read #1,ram2+7,10:close #1
  864.  return
  865.  
  866. ; read a file by slot #
  867. ; ~~~~~~~~~~~~~~~~~~~~~
  868.  
  869. nread
  870.  if left$(i$,1)="#" then i$=mid$(i$,2)
  871.  l=val(i$):if (l<2) or (l>253) then l=0:return
  872.  open #1,d1$:position #1,32,l
  873.  input #1,f$:if f$="" close #1:l=0:return
  874.  input #1,ty$:read #1,ram2+7,10:close #1
  875.  i$=f$:if pt=2 return:else print \"XT: [#"l"]: "i$:return
  876.  
  877. ; find the type of a file
  878. ; ~~~~~~~~~~~~~~~~~~~~~~~
  879.  
  880. dtype
  881.  use "a1:xtyp",f$:x=peek(ram2+32)
  882.  x$="???0TXT4PDA5BIN6ADB25AWP26ASP27SRC176OBJ177LIB178S16179RTL180EXE181"
  883.  x$=x$+"STR182RIF183NDA184CDA185SET186PNT192PIC193ANI194FNT200PAS239CMD240"
  884.  x$=x$+"COM245P16249BAS252VAR253REL254SYS255"
  885.  ty$="":y=instr(str$(x),x$):if y then ty$=mid$(x$,y-3,3):return
  886.  ty$="$"+chr$(48+x/16+((x/16)>9)*7)+chr$(48+x mod 16+((x mod 16)>9)*7)
  887.  return
  888.  
  889. ; set the type of a file
  890. ; ~~~~~~~~~~~~~~~~~~~~~~
  891.  
  892. type
  893.  use "a1:xtyp",f$,x:return
  894.  
  895. ; return the size of F$ in A
  896. ; ~~~~~~~~~~~~~~~~~~~~~~~~~~
  897.  
  898. size
  899.  open #1,f$:a=size(1)/2+1:close:return
  900.  
  901. ; see if file exists
  902. ; ~~~~~~~~~~~~~~~~~~
  903.  
  904. chkfil
  905.  open #1,f$:a=mark(1):return
  906.  
  907. ; update errant bit-map
  908. ; ~~~~~~~~~~~~~~~~~~~~~
  909.  
  910. biterr
  911.  open #1,"a1:xt.bitmap":read #1,ed+1,255:close
  912.  poke ed+l,255:open #1,"a1:xt.bitmap"
  913.  write #1,ed+1,255:close:open #1,"a1:xt.volumes"
  914.  position #1,32,l:print #1,chr$(13):close
  915.  return
  916.  
  917. ; :::::::::::::::::::
  918. ; special subroutines
  919. ; :::::::::::::::::::
  920.  
  921. ; save user's stats before CLEAR
  922. ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  923.  
  924. store
  925.  clear #8:byte=ram2:byte(0)=c:byte(1)=un mod 256
  926.  byte(2)=un/256:print #8,a1$,a2$,s$,lc$:return
  927.  
  928. ; recall a user's stats after CLEAR
  929. ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  930.  
  931. recall
  932.  c=byte(0):un=byte(1)+byte(2)*256
  933.  input #8,a1$,a2$,s$,lc$:return
  934.  
  935. ; get a file description
  936. ; ~~~~~~~~~~~~~~~~~~~~~~
  937.  
  938. edesc
  939.  create "a:ul.log":open #1,"a:ul.log"
  940.  append #1
  941.  print #1,a1$" "a2$" uploaded "f$" to volume "bb
  942.  print #1,"at "date$" "time$\
  943.  close #1
  944.  print '
  945. Enter description: 'edit(3)' cols, [4K] max 
  946. [DONE] when finished, [.H] for help'
  947.  edit(1):return
  948.  
  949. ; convert to a valid ProDOS name
  950. ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  951.  
  952. ; shorten I$ to directory length
  953.  
  954. name
  955.  if len(i$)>15 then i$=left$(i$,15)
  956.  i$=i$+chr$(1)
  957.  
  958. ; make sure the first char is a letter
  959.  
  960. name.0
  961.  a=asc(left$(i$,1)):if a=1 pop:return
  962.  if (a>64) and (a<91) then i$=left$(i$,len(i$)-1):goto name.1
  963.  if (a>96) and (a<123) then i$=left$(i$,len(i$)-1):goto name.1
  964.  i$=mid$(i$,2):goto name.0
  965.  
  966. ; remove symbols from the name
  967.  
  968. name.1
  969.  f$="":for x=1 to len(i$):a=asc(mid$(i$,x,1))
  970.  if (a>64) and (a<91) goto name.2
  971.  if (a>96) and (a<123) goto name.2
  972.  if (a>47) and (a<58) goto name.2
  973.  if a=46 goto name.2:else goto name.3
  974.  
  975. ; add a valid character
  976.  
  977. name.2
  978.  f$=f$+chr$(a)
  979.  
  980. ; if we dont have a name, return to the prompt
  981.  
  982. name.3
  983.  next:if f$="" pop:return
  984.  if len(f$)>15 then f$=left$(f$,15)
  985.  return
  986.  
  987. ; set file information
  988. ; ~~~~~~~~~~~~~~~~~~~~
  989.  
  990. sfile
  991.  byte(7)=byte(3):byte(8)=a mod 256:byte(9)=a/256
  992.  byte(10)=un mod 256:byte(11)=un/256:byte(16)=0
  993.  when$="x":if lb then byte(7)=255
  994.  return
  995.  
  996. ; ::::::::::::::
  997. ; error messages
  998. ; ::::::::::::::
  999.  
  1000. lsec
  1001.  print \"XT:"chr$(7)" Security too low...":return
  1002.  
  1003. dfull
  1004.  print \"XT:"chr$(7)" Directory full...":return
  1005.  
  1006. nfile
  1007.  print \"XT:"chr$(7)" No such file...":return
  1008.